Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/creattbl.fr_/creattbl.fr

Text File | 1995-03-09 | 10KB | 309 lines

VERSION 4.00
Begin VB.Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "Table Creator"
   ClientHeight    =   2880
   ClientLeft      =   645
   ClientTop       =   1455
   ClientWidth     =   7230
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   1
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   3285
   Left            =   585
   LinkTopic       =   "Form1"
   ScaleHeight     =   2880
   ScaleWidth      =   7230
   Top             =   1110
   Width           =   7350
   Begin VB.ListBox lstTables
      Height          =   1980
      Left            =   180
      TabIndex        =   4
      Top             =   660
      Width           =   1695
   End
   Begin VB.CommandButton cmdCreateTable
      Caption         =   "--> Create &Table -->"
      Enabled         =   0   'False
      Height          =   1035
      Left            =   2100
      TabIndex        =   2
      Top             =   900
      Width           =   2055
   End
   Begin VB.CommandButton cmdClose
      Cancel          =   -1  'True
      Caption         =   "Cl&ose"
      Height          =   495
      Left            =   2100
      TabIndex        =   1
      Top             =   2160
      Width           =   2055
   End
   Begin VB.CommandButton cmdCreateDatabase
      Caption         =   "&Create &Database"
      Height          =   495
      Left            =   2100
      TabIndex        =   0
      Top             =   180
      Width           =   2055
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Created Tables and Fields:"
      Height          =   195
      Left            =   4380
      TabIndex        =   6
      Top             =   360
      Width           =   2295
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Available Tables:"
      Height          =   195
      Left            =   180
      TabIndex        =   5
      Top             =   360
      Width           =   1485
   End
   Begin MSOutl.Outline outTablesAndFields
      Height          =   1995
      Left            =   4380
      TabIndex        =   3
      Top             =   660
      Width           =   2595
      _version        =   65536
      _extentx        =   4577
      _extenty        =   3519
      _stockprops     =   77
      backcolor       =   16777215
      pictureplus     =   "CREATTBL.frx":0000
      pictureminus    =   "CREATTBL.frx":0172
      pictureleaf     =   "CREATTBL.frx":02E4
      pictureopen     =   "CREATTBL.frx":0456
      pictureclosed   =   "CREATTBL.frx":05C8
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   1620
      Top             =   60
      _version        =   65536
      _extentx        =   847
      _extenty        =   847
      _stockprops     =   0
      cancelerror     =   -1  'True
      defaultext      =   "MDB"
      dialogtitle     =   "Create New Database"
      filter          =   "Microsoft Acccess (*.MDB)|*.MDB"
      flags           =   5000
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

' Declare the text field lengths as constants
Private Const LEN_Customer_Name = 40
Private Const LEN_Street_Address = 80
Private Const LEN_City = 25
Private Const LEN_State = 2
Private Const LEN_Zip_Code = 10
Private Const LEN_Country = 25
Private Const LEN_Item_Number = 16
Private Const LEN_Item_Description = 100

' Declare the database at form level.
Dim db As Database

Private Sub cmdCreateDatabase_Click()
    Dim fn As String
    Dim tblDef As TableDef

    On Error GoTo CreateError

    ' Set the filename to a null string and display the common dialog box.
    CommonDialog1.FileName = ""
    CommonDialog1.ShowSave

    ' The user entered a filename for the new database. Assign it to the variable fn.
    Screen.MousePointer = 11
    fn = CommonDialog1.FileName

    ' Create the new database file.
    Set db = DBEngine.Workspaces(0).CreateDatabase(fn, dbLangGeneral)
    Screen.MousePointer = 0

    ' Verify that the file now exists on disk.
    If Dir(fn) = CommonDialog1.FileTitle Then

        ' The file exists, so display a message.
        Form1.Caption = "Table Creator for " & UCase$(fn)

        ' Clear the existing list and outline
        lstTables.Clear
        outTablesAndFields.Clear

        ' Fill the list box with the sample tables
        lstTables.AddItem "Customers"
        lstTables.AddItem "Items"
        lstTables.AddItem "Order Items"
        lstTables.AddItem "Orders"

        ' Enable the Create Table features.
        cmdCreateTable.Enabled = True
    Else
        MsgBox "Could not create " & fn, vbExclamation
    End If
Exit Sub

CreateError:
    Screen.MousePointer = 0
    If Err.Number = 32755 Then
        ' The user cancelled the dialog box, so do nothing.
    Else
        ' Some other error, so show the user the description.
        MsgBox Err.Description
    End If
Exit Sub
End Sub

Private Sub cmdCreateTable_Click()
    Dim tableName As String
    Dim tblDef As TableDef

    On Error GoTo TableCreateError

    If lstTables.ListIndex > -1 Then

        ' The user has a table selected, so create a new table definition
        ' in the database with the name of the table.
        Screen.MousePointer = 11
        Set tblDef = db.CreateTableDef(lstTables.Text)

        ' Now add the appropriate fields to the table.
        AddFields tblDef


        ' With all the fields in place, append the table defintion to the database.
        db.TableDefs.Append tblDef

        ' Take the list off the list of available tables.
        tableName = lstTables.Text
        RemoveFromList tableName

        ' Put the table and its fields into the outline of tables in the database.
        AddToOutline tableName
    End If
    Screen.MousePointer = 0

Exit Sub

TableCreateError:
    Screen.MousePointer = 0
    MsgBox Err.Description
Exit Sub

End Sub
Sub AddFields(tblDef As TableDef)

    Dim fldDef As Field

    ' For each field, first create the field TableDef
    ' Then add it to the field list for the table
    Select Case lstTables.Text
        Case "Customers"
            Set fldDef = tblDef.CreateField("Customer Number", dbLong)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Customer Name", dbText, LEN_Customer_Name)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Street Address", dbText, LEN_Street_Address)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("City", dbText, LEN_City)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("State", dbText, LEN_State)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Zip Code", dbText, LEN_Zip_Code)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Country", dbText, LEN_Country)
            tblDef.Fields.Append fldDef
        Case "Items"
            Set fldDef = tblDef.CreateField("Item Number", dbText, LEN_Item_Number)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Item Description", dbText, LEN_Item_Description)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Price Each", dbCurrency)
            tblDef.Fields.Append fldDef
        Case "Orders"
            Set fldDef = tblDef.CreateField("Customer Number", dbLong)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Order Number", dbLong)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Order Date", dbDate)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Ship Date", dbDate)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Tax", dbCurrency)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Shipping Charge", dbCurrency)
            tblDef.Fields.Append fldDef
        Case "Order Items"
            Set fldDef = tblDef.CreateField("Order Number", dbLong)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Item Number", dbText, LEN_Item_Number)
            tblDef.Fields.Append fldDef
            Set fldDef = tblDef.CreateField("Quantity", dbLong)
            tblDef.Fields.Append fldDef
    End Select

End Sub

Private Sub lstTables_DblClick()
    cmdCreateTable_Click
End Sub
Sub RemoveFromList(tableName As String)
    Dim i As Integer

    ' Find the table passed as the argument in the list and remove it from the list.
    For i = 0 To lstTables.ListCount - 1
        If lstTables.List(i) = tableName Then
            lstTables.RemoveItem i
            Exit For
        End If
    Next i

End Sub
Sub AddToOutline(tableName As String)
    Dim tableIndex As Integer
    Dim tblDef As TableDef
    Dim i As Integer

    ' Indicate that the table name is to be added at the top level of the outline.
    outTablesAndFields.ListIndex = -1

    ' Add the table to the outline.
    outTablesAndFields.AddItem tableName

    ' Store the just-added table's ListIndex property in a variable.
    tableIndex = outTablesAndFields.ListCount - 1

    ' Add each field in the table to the outline as a subitem of the table name.
    Set tblDef = db.TableDefs(tableName)
    For i = 0 To tblDef.Fields.Count - 1
        outTablesAndFields.ListIndex = tableIndex
        outTablesAndFields.AddItem tblDef.Fields(i).Name
    Next
End Sub
Private Sub cmdClose_Click()
    End
End Sub